home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dpassb2.f < prev    next >
Text File  |  1989-08-14  |  986b  |  33 lines
  1.       subroutine dpassb2 (ido,l1,cc,ch,wa1)
  2. c
  3. c     Double precision version.  -tk
  4. c
  5. C***BEGIN PROLOGUE  DPASSB2
  6. C***REFER TO DCFFTB
  7. C***ROUTINES CALLED  (NONE)
  8. C***END PROLOGUE  DPASSB2
  9.       implicit double precision (a-h,o-z)
  10.       dimension       cc(ido,2,l1)           ,ch(ido,l1,2)           ,
  11.      1                wa1(1)
  12. C***FIRST EXECUTABLE STATEMENT  PASSB2
  13.       if (ido .gt. 2) go to 102
  14.       do 101 k=1,l1
  15.          ch(1,k,1) = cc(1,1,k)+cc(1,2,k)
  16.          ch(1,k,2) = cc(1,1,k)-cc(1,2,k)
  17.          ch(2,k,1) = cc(2,1,k)+cc(2,2,k)
  18.          ch(2,k,2) = cc(2,1,k)-cc(2,2,k)
  19.   101 continue
  20.       return
  21.   102 do 104 k=1,l1
  22.          do 103 i=2,ido,2
  23.             ch(i-1,k,1) = cc(i-1,1,k)+cc(i-1,2,k)
  24.             tr2 = cc(i-1,1,k)-cc(i-1,2,k)
  25.             ch(i,k,1) = cc(i,1,k)+cc(i,2,k)
  26.             ti2 = cc(i,1,k)-cc(i,2,k)
  27.             ch(i,k,2) = wa1(i-1)*ti2+wa1(i)*tr2
  28.             ch(i-1,k,2) = wa1(i-1)*tr2-wa1(i)*ti2
  29.   103    continue
  30.   104 continue
  31.       return
  32.       end
  33.